home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Unsorted / BinGfxGrabber.AMOS / BinGfxGrabber.amosSourceCode
Encoding:
AMOS Source Code  |  1997-11-01  |  1.9 KB  |  77 lines

  1. Set Buffer 100
  2. Screen Open 0,320,256,32,0
  3. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  4.  Extension_8_0456 "dh1:atr.bin",9
  5. ST=Start(9)
  6. P=0
  7. Gosub UPDAT
  8. WX=1 : WY=256 : NPL=1
  9. PALP=0
  10. Do 
  11.   Repeat 
  12.     Multi Wait 
  13.     I$=Inkey$ : KS=Key Shift : MK=Mouse Key
  14.   Until(I$<>"") or MK
  15.   XXX=Free
  16.   If I$="r" Then PALP=0
  17.   If I$="p"
  18.     Colour 0,$F00
  19.     Do 
  20.       Repeat : Add PALP,2 : Until Deek(ST+PALP)=0
  21.       ZZ=0
  22.       For A=0 To Extension_8_04F8(NPL)-1
  23.         PP=Deek(ST+PALP+A*2)
  24.         Exit If PP and $F000
  25.         ZZ=ZZ or PP
  26.       Next 
  27.       If A= Extension_8_04F8(NPL) and((ZZ and $F)>4) and((ZZ and $F0)>4) and((ZZ and $F00)>4)
  28.         For A=0 To Extension_8_04F8(NPL)-1
  29.           Colour A,Deek(ST+PALP+A*2)
  30.         Next 
  31.         Exit 
  32.       End If 
  33.     Loop 
  34.   End If 
  35.   If I$=" " Then Add P,WX*WY*NPL
  36.   If I$=Cup$ and(KS and 3) Then Add P,-WX*WY*NPL*2
  37.   If I$=Cdown$ and(KS and 3) Then Add P,WX*WY*NPL*2
  38.   If I$=Cup$ and(KS and 3)=0 Then Add P,-WX*NPL*2
  39.   If I$=Cdown$ and(KS and 3)=0 Then Add P,WX*NPL*2
  40.   If I$=Cleft$ and(KS and 3)=0 Then Add P,-2
  41.   If I$=Cright$ and(KS and 3)=0 Then Add P,2
  42.   If I$=Cleft$ and(KS and 3) Then WX=Max(WX-1,1)
  43.   If I$=Cright$ and(KS and 3) Then WX=Min(WX+1,20)
  44.   If I$="+" Then NPL=Min(NPL+1,5)
  45.   If I$="-" Then NPL=Max(NPL-1,1)
  46.   If I$="m" Then MO=1-MO
  47.   If MK=1 Then WY=Min(WY+1,256)
  48.   If MK=2 Then WY=Max(WY-1,16)
  49.   Gosub UPDAT
  50.   Home : Print Hex$(P,6);" W:"; Extension_8_0EB8(WX*16,3);" H:"; Extension_8_0EB8(WY,3);
  51.   Print " P:"; Extension_8_0EB8(NPL,1);" M:"; Extension_8_16A4("interleaved|normal",MO)
  52.   Exit If I$=Chr$(27)
  53. Loop 
  54. End 
  55. UPDAT:
  56.   Cls 
  57.   AD=P
  58.   If MO=0
  59.     For Y=0 To WY-1
  60.       For PL=0 To NPL-1
  61.         For X=0 To WX-1
  62.           Doke Logbase(PL)+X*2+Y*40,Deek(ST+AD)
  63.           Add AD,2
  64.         Next 
  65.       Next 
  66.     Next 
  67.   Else 
  68.     For PL=0 To NPL-1
  69.       For Y=0 To WY-1
  70.         For X=0 To WX-1
  71.           Doke Logbase(PL)+X*2+Y*40,Deek(ST+AD)
  72.           Add AD,2
  73.         Next 
  74.       Next 
  75.     Next 
  76.   End If 
  77. Return